home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1996 May: Tool Chest / Developer CD Series May 1996 (Tool Chest) (Apple Computer) (1996).iso / Tool Chest / Development Tools & Languages / Macintosh Common Lisp Related / User Contributions / Misc.sea / Misc / PlaySound.lisp < prev    next >
Encoding:
Text File  |  1993-02-26  |  2.8 KB  |  80 lines  |  [TEXT/CCL2]
  1. ;; file PlaySound.lisp
  2. ;; asynchronous call to the old sound-driver's square wave synthesizer.
  3. ;; this will work on any and every macintosh in existance today.
  4. ;;
  5. ;; Copyright (c) 1993 by John Montbriand. All Rights Reserved.
  6. ;; you may re-distribute this file as you see fit so long
  7. ;; as this notice remains intact.
  8.  
  9.  
  10. ;; playit uses the square wave synthesizer to play a list of sounds.
  11. ;; note: this is equivalent to a call to StartSound in the
  12. ;; older 64k ROM interface which appears to have been dropped
  13. ;; from the current interfaces.
  14. ;;   - triplets is a list of (frequency amplitude duration)'s
  15. ;;   - does no error checking on the #_NewPtr request, be careful
  16. ;;     if you're using this in a low memory situation.
  17. (defun playit (triplets)
  18.   (let ((buf (#_NewPtr (+ 8 (* 6 (length triplets)))))
  19.         (offset 2))
  20.     (unless (%null-ptr-p buf)
  21.         (%put-word buf -1 0)                ; swMode
  22.         (dolist (trip triplets)
  23.           (%put-word buf (car trip) offset)         ; frequency
  24.           (%put-word buf (cadr trip) (+ 2 offset))  ; amplitude
  25.           (%put-word buf (caddr trip) (+ 4 offset)) ; duration
  26.           (setq offset (+ 6 offset)))
  27.         (%put-word buf 0 offset)            ; a zero element
  28.         (%put-word buf 0 (+ 2 offset))
  29.         (%put-word buf 0 (+ 4 offset))
  30.         (setq offset (+ 6 offset))
  31.         (rlet ((pb :ParamBlockRec
  32.                    :ioCompletion (%null-ptr)
  33.                    :ioVRefNum   0
  34.                    :ioRefNum    -4          ; the sound driver
  35.                    :ioBuffer    buf
  36.                    :ioReqCount  offset
  37.                    :ioPosOffset 0))
  38.           (#_PBWrite :async pb)
  39.           (do () ((<= (rref pb ParamBlockRec.ioResult) 0)) 
  40.             (event-dispatch)))
  41.         (#_DisposePtr buf))))
  42.  
  43. #|
  44. ;; example usage (twilight zone theme):
  45.  
  46. (playit `((396 127 5) (0 0 2)
  47.           (371 127 10) (0 0 2)
  48.           (396 127 10) (0 0 2)
  49.           (494 127 10) (0 0 2)
  50.           
  51.           (396 127 10) (0 0 2)
  52.           (371 127 10) (0 0 2)
  53.           (396 127 10) (0 0 2)
  54.           (494 127 10)
  55.           
  56.           (396 127 10) (0 0 2)
  57.           (371 127 10) (0 0 2)
  58.           (396 127 10) (0 0 2)
  59.           (494 127 10)))
  60.  
  61.  
  62. ;; morse code generating 6 dits per second
  63. (setq dah '((0 127 2) (492 127 6) (0 127 2)))
  64. (setq dit '((0 127 5) (492 127 1) (0 127 4)))
  65. (setq space '((0 127 10)))
  66. (setq end_mssg (append dit dah dit dah dit))
  67.  
  68. (setq john (append dit dah dah dah space dah dah dah space dit dit dit
  69.                    dit space dah dit))
  70. (setq montbriand (append dah dah space dah dah dah space dah dit space dah
  71.                          space dah dit dit dit space dit dah dit space dit
  72.                          dit space dit dah space dah dit space dah dit dit space))
  73.  
  74. ;; the author's name in morse code:
  75. (playit (append space john space montbriand space end_mssg))
  76.  
  77. |#
  78.  
  79. ;; end of file PlaySound.lisp
  80.